home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / pgmmenu.arc / CRC1230.CLP next >
Text File  |  1991-12-04  |  52KB  |  1,221 lines
  1.  CRC1230:    PGM        PARM(&USROPT &XSRCFILE &XSRCLIB &XOBJLIB +
  2.                           &XJOBD &XLOG &SIGNOFF &LOGCLPGM &ALWRTVSRC +
  3.                           &USRPRF &PUBAUT &RSTDSP &DFRWRT &SIZE +
  4.                           &MAXRCD &PRTSCH &IN71 &RSTLBL &MBRLST +
  5.                           &DFTYPE &SHARE &OPTIMIZE)
  6.  
  7.              /*         Program - CRC1230  */
  8.  
  9.              /*         CRC - Programmer Menu */
  10.              /*         Compile this version with:        */
  11.              /*                 DFRWRT(*NO) RSTDSP(*YES)  */
  12.  
  13.  COPYRIGHT:  DCL        VAR(©RIGHT) TYPE(*CHAR) LEN(64)  +
  14.                           VALUE('(c) Copyright 1986 by CRC, Inc. +
  15.                                      All rights reserved.')
  16.  
  17.              DCL        &PGMNAM  *CHAR 10  VALUE('CRC1230')
  18.              DCL        &USROPT  *CHAR 20    /* User defaults option */
  19.              DCL        &BLINK   *CHAR 04    /* Blinking cursor */
  20.              DCL        &USER    *CHAR 10    /* User ID */
  21.              DCL        &JOBTYPE *CHAR 01    /* Job type */
  22.              DCL        &SRCDFT  *LGL   1    /* Source default used */
  23.              DCL        &SRCSAVE *CHAR 10    /* Saved source file */
  24.              DCL        &MNUDFT  *CHAR 2000  /* User defaults */
  25.              DCL        &GENOPT  *CHAR 64    /* Gen Options */
  26.  
  27.              DCL        &BLANKS  *CHAR 10  /* Constant of blanks */
  28.              DCL        &BLANK   *CHAR 01  /* Constant of a blank */
  29.              DCL        &JOBNAME *CHAR 10  /* Submitted job name */
  30.              DCL        &WSID    *CHAR 10  /* Job name (Workstn-ID) */
  31.              DCL        &LENGTH *DEC (15 5)
  32.              DCL        &OFFSET1 *DEC 3
  33.              DCL        &OFFSET2 *DEC 3
  34.  
  35.              DCL        &CMD     *CHAR 512 /* Command to execute */
  36.              DCL        &DSP     *CHAR 01  /* Re-displayed menu Sws */
  37.              DCL        &OBJTYPE *CHAR 08  /* Object type  */
  38.              DCL        &P04     *LGL  01  VALUE('0')
  39.              DCL        &P16     *LGL  01  VALUE('0')
  40.              DCL        &ON  *LGL VALUE('1')
  41.              DCL        &OFF *LGL VALUE('0')
  42.  
  43.              /*         Display attributes  */
  44.              DCL        &X26     *CHAR 01  VALUE(X'26') /* UL HI */
  45.              DCL        &X24     *CHAR 01  VALUE(X'24') /* UL */
  46.              DCL        &X22     *CHAR 01  VALUE(X'22') /* HI */
  47.              DCL        &X20     *CHAR 01  VALUE(X'20') /* Term */
  48.  
  49.              DCL        &LIBL    *CHAR 275 /* Job's library list */
  50.              DCL        &SAVLIBL *CHAR 275 /* Original library list */
  51.              DCL        &SIZE    *CHAR 21  /* File size default */
  52.              DCL        &SRCTYPE *CHAR 05  /* Type: ____ entry */
  53.              DCL        &PROMPT  *CHAR 04  /* Prompt flag */
  54.              DCL        &XJOBD   *CHAR 20  /* JodD/JobD-library */
  55.  
  56.              DCL        &CNT     *DEC  05  /* Work counter variable */
  57.              DCL        &CNT1    *DEC  05  /* Work counter variable */
  58.              DCL        &CNT2    *DEC  05  /* Work counter variable */
  59.              DCL        &CNT3    *DEC  05  /* Work counter variable */
  60.  
  61.              /*  Work variables for finding the OBJECT.LIBRARY  +
  62.                  name in a prompted CRTxxx command.  */
  63.              DCL        &TWICE *LGL  1
  64.              DCL        &NOLIB *LGL  1
  65.              DCL        &OBJNAME *CHAR 10
  66.              DCL        &LIBNAME *CHAR 10
  67.              DCL        &WORKOBJ *CHAR 12
  68.  
  69.              /*         Message variables */
  70.              DCL        &MSGKEY  *CHAR 04
  71.              DCL        &MSGID   *CHAR 07
  72.              DCL        &SECLVL  *CHAR 256
  73.              DCL        &MSGLEN  *DEC  05
  74.              DCL        &MSGDTA  *CHAR 132
  75.              DCL        &SENDER  *CHAR 80
  76.              DCL        &RTNTYPE *CHAR 2
  77.  
  78.              DCLF       FILE(CRC1230)
  79.              MONMSG     MSGID(CPF0000 MCH0000 EDT0000) +
  80.                            EXEC(GOTO ERROR)
  81.  
  82.              CHGVAR     VAR(©RIGHT) VALUE(©RIGHT)
  83.  
  84.              CHGVAR     VAR(&PGMSGQ) VALUE(&PGMNAM) /* Pgm MsgQ */
  85.  
  86.              RTVJOBA    JOB(&WSID) USER(&USER) TYPE(&JOBTYPE) +
  87.                           USRLIBL(&SAVLIBL)
  88.  
  89.              IF         (&JOBTYPE *EQ '0') DO  /* Batch Job. */
  90.              SNDPGMMSG  MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' +
  91.                           *CAT 'PGMMENU can execute only from an +
  92.                           interactive environment.  Request +
  93.                           cancelled.') MSGTYPE(*DIAG)
  94.                RETURN
  95.              ENDDO
  96.  
  97.              /*         Retrieve the system name */
  98.              RTVSYSINF  TYPE(*SYSNAM) RTNVAR(&SYSNAM)
  99.  
  100.              IF         (%SST(&USROPT 1 10) *EQ *CURRENT) DO
  101.                CHGVAR     VAR(&USROPT) VALUE(&USER *CAT '*LIBL')
  102.                GOTO       GETDFT
  103.              ENDDO
  104.  
  105.              IF         (&USROPT *EQ *DFT) DO
  106.                /*  If USROPT(*DFT), then use dataarea in QGPL */
  107.                CHGVAR     VAR(&USROPT) VALUE('PGMMENU   QGPL      ')
  108.                GOTO       GETDFT
  109.              ENDDO
  110.  
  111.              IF         (&USROPT *EQ *NONE) DO
  112.                CHGVAR     VAR(&SIZE1) VALUE(%SST(&SIZE 03 8))
  113.                CHGVAR     VAR(&SIZE2) VALUE(%SST(&SIZE 11 5))
  114.                CHGVAR     VAR(&SIZE3) VALUE(%SST(&SIZE 16 6))
  115.                CHGVAR     VAR(&JOBD)  VALUE(%SST(&XJOBD  01 10))
  116.                CHGVAR     VAR(&JOBDLIB) VALUE(%SST(&XJOBD  11 10))
  117.                CHGVAR     VAR(&LOG)     VALUE(&XLOG)
  118.              ENDDO
  119.              ELSE       GOTO GETDFT /* return to here when done */
  120.  
  121.  SNDRQSMSG:  SNDPGMMSG  MSG('CRC - COZZI UTILITIES') TOPGMQ(*SAME) +
  122.                           MSGTYPE(*RQS) KEYVAR(&MSGKEY)
  123.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  124.                           RMV(*NO)
  125.              SNDPGMMSG  MSG(©RIGHT) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  126.                           KEYVAR(&MSGKEY)
  127.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  128.                           RMV(*NO)
  129.              SNDPGMMSG  MSG('CRC - Programmer Menu started') +
  130.                           TOPGMQ(*SAME) MSGTYPE(*RQS) KEYVAR(&MSGKEY)
  131.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  132.                           RMV(*NO)
  133.  
  134.  SETDFT:     CHGVAR     VAR(&SRCLIB) VALUE(&XSRCLIB)
  135.              CHGVAR     VAR(&OBJLIB) VALUE(&XOBJLIB)
  136.              IF         (&JOBDLIB *EQ &BLANKS) DO
  137.                CHGVAR     VAR(&JOBDLIB) VALUE('*LIBL')
  138.              ENDDO
  139.              CHGVAR     VAR(&LOG)    VALUE(&XLOG)
  140.              IF         (&SRCFILE *EQ &BLANKS) DO
  141.                CHGVAR     VAR(&SRCFILE) VALUE(&XSRCFILE)
  142.              ENDDO
  143.  
  144.  ROLL:       IF          (&IN26) DO /* ROLL UP */
  145.                SNDF       RCDFMT(OPTMNU2)
  146.                CHGVAR     VAR(&DSP) VALUE('2')
  147.              ENDDO
  148.              ELSE        DO  /* ROLL DOWN */
  149.                SNDF       RCDFMT(OPTMNU1)
  150.                CHGVAR     VAR(&DSP) VALUE('1')
  151.              ENDDO
  152.  
  153.  HEADING:    SNDF       RCDFMT(HEADING1)  /* Write Disply heading 1 */
  154.              SNDF       RCDFMT(HEADING2)  /* Write Disply heading 2 */
  155.  
  156.  MENU:
  157.              IF         (*NOT &IN83)   DO
  158.                CHGVAR     VAR(&OPTION) VALUE(0)
  159.              ENDDO
  160.  
  161.              IF         ((&XSRCFILE *EQ &BLANKS) *AND (&SRCDFT)) +
  162.              DO
  163.                CHGVAR     VAR(&SRCDFT) VALUE('0')
  164.                CHGVAR     VAR(&SRCFILE) VALUE(&BLANKS)
  165.              ENDDO
  166.  
  167.  MSGCTL:     SNDF       RCDFMT(MSGCTL)   /* Program messages */
  168.                IF       (&LOG *EQ '*NO') DO
  169.                  RMVMSG  MSGKEY(&MSGKEY)
  170.                  MONMSG  MSGID(CPF0000)
  171.                ENDDO
  172.  
  173.  SNDRCVF:    SNDRCVF    RCDFMT(PGMMENU)  /* Menu control record */
  174.  
  175.              IF         ((&OPTION *EQ 0) *AND (*NOT &IN91)) +
  176.                          GOTO SNDRCVF
  177.  
  178.              IF         ((&OPTION *EQ 3) *AND (&IN83) *AND +
  179.                          (*NOT &IN92)) DO
  180.                CHGVAR     VAR(&IN83) VALUE(&OFF)
  181.                GOTO       CHECKCRT
  182.              ENDDO
  183.  
  184.              CHGVAR     VAR(&CMD) VALUE(&BLANKS) /* Inz work var. */
  185.  
  186.              IF         COND(&OPTION *GT 0) THEN(GOTO CMDLBL(OPTIONS))
  187.  
  188.        /*     Determine if roll keys are pressed.  */
  189.               IF (&DSP *EQ '1') DO
  190.  RCVF1:        RCVF       RCDFMT(OPTMNU1)
  191.                MONMSG     MSGID(CPF0000)
  192.              ENDDO
  193.              ELSE     IF  (&DSP *EQ '2') DO
  194.  RCVF2:        RCVF       RCDFMT(OPTMNU2)
  195.                MONMSG     MSGID(CPF0000)
  196.              ENDDO
  197.  
  198.              /*         IF  RollUp or RollDown, then +
  199.                         branch to ROLL: SNDF for new display.  */
  200.              IF         (&IN26 *OR &IN27) GOTO ROLL
  201.  
  202.              CHGVAR     VAR(&CNT) VALUE(0) /* Reset counter */
  203.  
  204.  CMD24:      IF         (&IN24) DO         /* Display/Change */
  205.                SNDRCVF    RCDFMT(PGMDFT1)   /* session defaults. */
  206.                SNDRCVF    RCDFMT(PGMDFT2)   /* session defaults. */
  207.                GOTO       SETDFT
  208.              ENDDO
  209.                         /*  Do HelpText routine. */
  210.  HELP:       IF         (&IN30) GOTO HELPTEXT
  211.  
  212.  CMD1:       IF         (&IN01) DO
  213.                IF         (&RSTLBL *EQ *YES) DO
  214.                  CHGVAR     VAR(&CMD) VALUE('RPLLIBL (' *CAT &SAVLIBL +
  215.                               *TCAT ')')
  216.                  CALL       QCAEXEC PARM(&CMD 512)
  217.                ENDDO
  218.                RETURN
  219.              ENDDO
  220.  
  221.  CMD6:       IF         (&IN06) DO
  222.                DSPMSG
  223.                GOTO       MENU
  224.              ENDDO
  225.  
  226.  CMD3:       IF         (&IN03)  +
  227.              DO
  228.  CMDENTRY:     RCVMSG     PGMQ(*EXT) MSGTYPE(*RQS) RMV(*NO) +
  229.                           KEYVAR(&MSGKEY) MSG(&CMD) MSGLEN(&MSGLEN) +
  230.                           RTNTYPE(&RTNTYPE)
  231.                 MONMSG     MSGID(CPF2415) EXEC(DO)
  232.                   RCVMSG     MSGTYPE(*EXCP)
  233.                   CHGVAR     VAR(&CMD) VALUE(&BLANKS)
  234.                   GOTO     MENU
  235.               ENDDO
  236.  
  237.              IF         (&CMD *EQ &BLANKS) GOTO CMDENTRY
  238.  
  239.              IF         (%SST(&CMD 01 01) *EQ &BLANK) DO
  240.              CHGVAR     VAR(&CNT) VALUE(1)
  241.  BLANKLOOP:  CHGVAR     VAR(&CNT) VALUE(&CNT + 1)
  242.              IF         (&CNT *LT 512) DO
  243.              IF         (%SST(&CMD &CNT 01) *EQ &BLANK) GOTO BLANKLOOP
  244.              CHGVAR     VAR(&CNT2) VALUE(512 - &CNT + 1)
  245.              CHGVAR     VAR(&CMD) VALUE(%SST(&CMD &CNT &CNT2))
  246.                ENDDO
  247.                ENDDO
  248.  
  249.                IF         (%SST(&CMD 01 01) *EQ '?') DO
  250.                 CHGVAR     VAR(&RTNTYPE) VALUE('10')
  251.                 CHGVAR     VAR(%SST(&CMD 01 01)) VALUE(' ')
  252.                ENDDO
  253.  
  254.                IF       (&RTNTYPE *EQ '10') DO  /* Prompter? */
  255.  
  256.                  IF        (*NOT  (%SST(&CMD 01 01) *EQ '?'))  DO
  257.                    CHGVAR     VAR(&CMD)  VALUE('?' *BCAT &CMD)
  258.                  ENDDO
  259.  
  260.                  CALL       QCACHECK PARM(&CMD 512)
  261.                  MONMSG     MSGID(CPF0000) EXEC(DO)
  262.                    GOTO       CMDENTRY
  263.                  ENDDO
  264.                  RMVMSG     MSGKEY(&MSGKEY)
  265.                  SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS)
  266.  
  267.                ENDDO
  268.  
  269.                CALL       QCAEXEC PARM(&CMD 512)
  270.                MONMSG     MSGID(CPF0000)
  271.  
  272.                GOTO       CMDENTRY
  273.              ENDDO
  274.  
  275.  CMD12:      IF         (&IN12) DO     /*  Replace library list. */
  276.  
  277.              SNDPGMMSG  MSG('Option CMD12:  Replace library list.') +
  278.                           TOPGMQ(*SAME) MSGTYPE(*RQS) KEYVAR(&MSGKEY)
  279.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  280.                           RMV(*NO)
  281.  
  282.              IF         (&OPTION *NE 0) DO
  283.              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Command +
  284.                           key not valid with selected option.') +
  285.                           TOPGMQ(*SAME) MSGTYPE(*DIAG)
  286.              GOTO       ERROR
  287.              ENDDO
  288.  
  289.                RTVJOBA    USRLIBL(&LIBL)
  290.                CHGVAR     VAR(&CMD)  +
  291.                             VALUE('? RPLLIBL (' *CAT &LIBL *TCAT ')')
  292.  
  293.              SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  294.                           KEYVAR(&MSGKEY)
  295.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  296.                           RMV(*NO)
  297.  
  298.                CALL       QCACHECK PARM(&CMD 512)
  299.  
  300.                RMVMSG     MSGKEY(&MSGKEY)
  301.                SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  302.                           KEYVAR(&MSGKEY)
  303.                RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  304.                            RMV(*NO)
  305.                CALL       QCAEXEC  PARM(&CMD 512)
  306.                GOTO       ERROR
  307.              ENDDO
  308.  
  309.  CMD18:      IF         (&IN18) DO    /* Reset defaults */
  310.               IF         (%SST(&USROPT 01 10) *EQ '*NONE') DO
  311.                SNDPGMMSG  MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' +
  312.                           *CAT 'USROPT(*NONE) specified on PGMMENU +
  313.                           command.  Cannot revert to user defaults.') +
  314.                           TOPGMQ(*SAME) MSGTYPE(*DIAG)
  315.               GOTO       MENU
  316.               ENDDO
  317.               ELSE       GOTO  GETDFT  /* Get user defaults */
  318.              ENDDO
  319.  
  320.  CMD20:      IF         (&IN20) DO     /* Toggle blinking cursor */
  321.               IF         (&IN71) CHGVAR VAR(&IN71) VALUE('0')
  322.               ELSE       CHGVAR VAR(&IN71) VALUE('1')
  323.               GOTO       MENU
  324.              ENDDO
  325.  
  326.  OPTIONS:    /*         Menu Options selection starts here */
  327.              IF         (&OPTION *EQ 0) DO  /* If no option, then */
  328.                GOTO     SNDRCVF             /* go redisplay menu */
  329.              ENDDO
  330.  
  331.              IF          ((&IN04) *AND ((&OPTION *NE 3) *AND +
  332.                           (&OPTION *NE 5) *AND (&OPTION *NE 6) *AND +
  333.                           (&OPTION *NE 7) *AND (&OPTION *NE 11))) +
  334.              Then(DO)   /* Invalid prompting request */
  335.                CHGVAR     VAR(&IN81) VALUE('1') /* Not valid option */
  336.              SNDPGMMSG  MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' +
  337.                           *CAT 'CMD 4 pressed, but, option 3, 5, 6, +
  338.                           7, 11 or 90 not selected.') TOPGMQ(*SAME) +
  339.                           MSGTYPE(*DIAG)
  340.                GOTO       ERROR
  341.              ENDDO
  342.  
  343.              /*         Insert menu defaults  */
  344.              IF         (&SRCLIB  *EQ &BLANKS) +
  345.              CHGVAR     VAR(&SRCLIB) VALUE(&XSRCLIB)
  346.              IF         (&OBJLIB *EQ &BLANKS) +
  347.              CHGVAR     VAR(&OBJLIB) VALUE(&XOBJLIB)
  348.              IF         (&JOBD *EQ &BLANKS) +
  349.              CHGVAR     VAR(&JOBD) VALUE(&XJOBD)
  350.              IF         (&LOG *EQ  &BLANKS) +
  351.              CHGVAR     VAR(&LOG)  VALUE(&XLOG)
  352.  
  353.              IF          (&SRCFILE *EQ &BLANKS) DO
  354.               CHGVAR    VAR(&SRCFILE) VALUE(&XSRCFILE)
  355.              ENDDO
  356.  
  357.              /*         IF default srcfile then +
  358.                         build default source file name. */
  359.              IF             (&SRCFILE *EQ &BLANKS) +
  360.              DO
  361.              /*         Build default source file name. */
  362.              CHGVAR     VAR(&SRCDFT) VALUE('1')
  363.              IF         (&TYPE *EQ &BLANKS) CHGVAR VAR(&SRCFILE) +
  364.                           VALUE('QTXTSRC')
  365.  ELSE        IF         (&TYPE *EQ 'CLP') CHGVAR VAR(&SRCFILE) +
  366.                           VALUE('QCLSRC')
  367.  ELSE        IF         (&TYPE *EQ 'DFU' *OR &TYPE *EQ 'QRY') +
  368.                           CHGVAR   VAR(&SRCFILE) VALUE('QIDUSRC')
  369.  ELSE        IF         (&TYPE *EQ BASP) CHGVAR VAR(&SRCFILE) +
  370.                           VALUE('QBASSRC')
  371.  ELSE        IF         (&TYPE *EQ RPT) CHGVAR VAR(&SRCFILE) +
  372.                           VALUE('QRPGSRC')
  373.  ELSE        IF            ((&TYPE *EQ BSCF)  +
  374.                         *OR (&TYPE *EQ CMNF)  +
  375.                         *OR (&TYPE *EQ DSPF)  +
  376.                         *OR (&TYPE *EQ LF)    +
  377.                         *OR (&TYPE *EQ MXDF)  +
  378.                         *OR (&TYPE *EQ PF)    +
  379.                         *OR (&TYPE *EQ PRTF)) +
  380.                          CHGVAR VAR(&SRCFILE) VALUE('QDDSSRC')
  381.  
  382.  ELSE        CHGVAR     VAR(&SRCFILE) VALUE('Q' *CAT &TYPE *TCAT 'SRC')
  383.  
  384.              ENDDO
  385.  
  386.  CLRPGMQ:    SNDPGMMSG  MSG('CRC - COZZI UTILITIES') TOPGMQ(*SAME) +
  387.                           MSGTYPE(*RQS) KEYVAR(&MSGKEY)
  388.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  389.                           RMV(*NO)
  390.  
  391.              SNDF       RCDFMT(MSGCTL)   /* Program messages */
  392.              RMVMSG     MSGKEY(&MSGKEY) CLEAR(*BYKEY)
  393.  
  394.              /*         This code was added to +
  395.                         improve response time. */
  396.              IF         (&OPTION *EQ 1)  GOTO OPTION1
  397.              IF         (&OPTION *EQ 2)  GOTO OPTION2
  398.              IF         (&OPTION *EQ 3)  GOTO OPTION3
  399.              IF         (&OPTION *EQ 4)  GOTO OPTION4
  400.              IF         (&OPTION *EQ 5)  GOTO OPTION5
  401.              IF         (&OPTION *EQ 6)  GOTO OPTION6
  402.              IF         (&OPTION *EQ 7)  GOTO OPTION7
  403.              IF         (&OPTION *EQ 8)  GOTO OPTION8
  404.              IF         (&OPTION *EQ 9)  GOTO OPTION9
  405.              IF         (&OPTION *EQ 80) GOTO OPTION80
  406.              IF         (&OPTION *EQ 90) GOTO OPTION90
  407.  
  408.              IF         (&OPTION *EQ 11) GOTO OPTION11
  409.              IF         (&OPTION *EQ 12) GOTO OPTION12
  410.              IF         (&OPTION *EQ 13) GOTO OPTION13
  411.              IF         (&OPTION *EQ 14) GOTO OPTION14
  412.              IF         (&OPTION *EQ 15) GOTO OPTION15
  413.              IF         (&OPTION *EQ 16) GOTO OPTION16
  414.              IF         (&OPTION *EQ 17) GOTO OPTION17
  415.              IF         (&OPTION *EQ 18) GOTO OPTION18
  416.              IF         (&OPTION *EQ 19) GOTO OPTION19
  417.              IF         (&OPTION *EQ 20) GOTO OPTION20
  418.              GOTO       ERROR
  419.  
  420.              /*        Menu selection starts here  */
  421.  OPTION1:    IF         (&OPTION *EQ 1) +
  422.              DO         /* Design/Execute DFU Application */
  423.              IF         (&PARM *EQ &BLANKS) CHGVAR VAR(&PARM) +
  424.                           VALUE('*PRV')
  425.              IF         (&PARM2 *EQ &BLANKS) CHGVAR VAR(&PARM2) +
  426.                           VALUE('*SELECT')
  427.              CHGVAR     VAR(&CMD) VALUE('DSNDFUAPP APP(' *CAT &PARM +
  428.                           *TCAT '.' *CAT &OBJLIB *TCAT ') OPTION(' +
  429.                           *CAT &PARM2 *TCAT ')')
  430.  
  431.              SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  432.                           KEYVAR(&MSGKEY)
  433.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  434.                           RMV(*NO)
  435.  
  436.              CALL       QCACHECK PARM(&CMD 512)
  437.              MONMSG     MSGID(CPF0006) EXEC(DO)
  438.              RCVMSG     RMV(*YES)
  439.              GOTO       ERROR
  440.              ENDDO
  441.              CALL       QCAEXEC PARM(&CMD 512)
  442.              GOTO       ERROR
  443.              ENDDO
  444.  
  445.  OPTION2:    IF         (&OPTION *EQ 2) +
  446.              DO         /* Design/Execute QRY Application */
  447.              IF         (&PARM *EQ &BLANKS) CHGVAR VAR(&PARM) +
  448.                           VALUE('*PRV')
  449.              IF         (&PARM2 *EQ &BLANKS) CHGVAR VAR(&PARM2) +
  450.                           VALUE('*SELECT')
  451.              CHGVAR     VAR(&CMD) VALUE('DSNQRYAPP APP(' *CAT &PARM +
  452.                           *TCAT '.' *CAT &OBJLIB *TCAT ') OPTION(' +
  453.                           *CAT &PARM2 *TCAT ')')
  454.  
  455.              SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  456.                           KEYVAR(&MSGKEY)
  457.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  458.                           RMV(*NO)
  459.  
  460.              CALL       QCACHECK PARM(&CMD 512)
  461.              MONMSG     MSGID(CPF0006) EXEC(DO)
  462.              RCVMSG     RMV(*YES)
  463.              GOTO       ERROR
  464.              ENDDO
  465.              CALL       QCAEXEC PARM(&CMD 512)
  466.              GOTO       ERROR
  467.              ENDDO
  468.  
  469.  OPTION3:    IF         (&OPTION *EQ 3)  +
  470.              DO         /* Create an object  */
  471.  
  472.              CHGVAR     VAR(&CMD) VALUE('Option 3: CrtObj - ' *CAT +
  473.                           &PARM *TCAT '.' *TCAT &OBJLIB *BCAT +
  474.                           'Srcfile - ' *CAT &SRCFILE *TCAT '.' *CAT +
  475.                           &SRCLIB *BCAT 'Type - ' *CAT &TYPE)
  476.  
  477.              SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  478.                           KEYVAR(&MSGKEY)
  479.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  480.                           RMV(*NO)
  481.  
  482.              IF         (&PARM *EQ &BLANKS) DO
  483.              SNDPGMMSG  MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' +
  484.                           *CAT 'Program name is blank.  When option 3 +
  485.                           is selected, a program name is required.') +
  486.                           TOPGMQ(*SAME) MSGTYPE(*DIAG)
  487.              GOTO       ERROR
  488.              ENDDO
  489.  
  490.           IF           ((&TYPE *EQ 'BASP') +
  491.              *OR        (&TYPE *EQ 'CLP')  +
  492.              *OR        (&TYPE *EQ 'QRY')  +
  493.              *OR        (&TYPE *EQ 'DFU')  +
  494.              *OR        (&TYPE *EQ 'CBL')  +
  495.              *OR        (&TYPE *EQ 'RPG')  +
  496.              *OR        (&TYPE *EQ 'RPT')  +
  497.              *OR        (&TYPE *EQ 'PL1')  +
  498.              *OR        (&TYPE *EQ 'ASM')) +
  499.               Then(CHGVAR    VAR(&OBJTYPE) VALUE('*PGM'))
  500.          ELSE IF       ((&TYPE *EQ 'BSCF')  +
  501.              *OR        (&TYPE *EQ 'CMNF')  +
  502.              *OR        (&TYPE *EQ 'DSPF')  +
  503.              *OR        (&TYPE *EQ 'PF')    +
  504.              *OR        (&TYPE *EQ 'LF')    +
  505.              *OR        (&TYPE *EQ 'MXDF')  +
  506.              *OR        (&TYPE *EQ 'PRTF')) +
  507.               Then(CHGVAR VAR(&OBJTYPE) VALUE('*FILE '))
  508.          ELSE      CHGVAR VAR(&OBJTYPE) VALUE('*' *CAT &TYPE)
  509.  
  510.              IF         (&OPTIMIZE *EQ '*YES') DO
  511.              CHGVAR     VAR(%SST(&GENOPT 01 11)) VALUE('*OPTIMIZE  ')
  512.              ENDDO
  513.              ELSE       DO
  514.              CHGVAR     VAR(%SST(&GENOPT 01 11)) VALUE('*NOOPTIMIZE')
  515.              ENDDO
  516.              /*         Build the create object command string */
  517.  
  518.              IF         (&TYPE *EQ CMD) DO
  519.              RTVMSG     MSGID(PGM0001) MSGF(PGMMSGF) MSGDTA(&PARM +
  520.                           *CAT &OBJLIB *CAT &PARM2 *CAT &SRCFILE *CAT +
  521.                           &SRCLIB *CAT &PUBAUT *CAT &TEXT) MSG(&CMD) +
  522.                           /* Command */
  523.              GOTO       CHECKCRT
  524.              ENDDO
  525.  
  526.              IF         (&TYPE *EQ CLP) DO
  527.              RTVMSG     MSGID(PGM0002) MSGF(PGMMSGF) MSGDTA(&PARM +
  528.                           *CAT &OBJLIB *CAT &SRCFILE *CAT &SRCLIB +
  529.                           *CAT &USRPRF *CAT &LOGCLPGM *CAT &ALWRTVSRC +
  530.                           *CAT &PUBAUT *CAT &TEXT) MSG(&CMD) /* +
  531.                           Control language program */
  532.              GOTO       CHECKCRT
  533.              ENDDO
  534.  
  535.              IF         (&TYPE *EQ CMNF) DO
  536.              RTVMSG     MSGID(PGM0003) MSGF(PGMMSGF) MSGDTA(&PARM +
  537.                           *CAT &OBJLIB *CAT &SRCFILE *CAT &SRCLIB +
  538.                           *CAT &PUBAUT *CAT &TEXT) MSG(&CMD) /* +
  539.                           Communications file */
  540.              GOTO       CHECKCRT
  541.              ENDDO
  542.  
  543.              IF         (&TYPE *EQ DFU)  DO
  544.              RTVMSG     MSGID(PGM0004) MSGF(PGMMSGF) MSGDTA(&PARM +
  545.                           *CAT &OBJLIB *CAT &SRCFILE *CAT &SRCLIB +
  546.                           *CAT &USRPRF *CAT &PUBAUT *CAT &TEXT) +
  547.                           MSG(&CMD) /* DFU application */
  548.              GOTO       CHECKCRT
  549.              ENDDO
  550.  
  551.              IF         (&TYPE *EQ QRY)  DO
  552.              RTVMSG     MSGID(PGM0005) MSGF(PGMMSGF) MSGDTA(&PARM +
  553.                           *CAT &OBJLIB *CAT &SRCFILE *CAT &SRCLIB +
  554.                           *CAT &USRPRF *CAT &PUBAUT *CAT &TEXT) +
  555.                           MSG(&CMD) /* Query application */
  556.              GOTO       CHECKCRT
  557.              ENDDO
  558.  
  559.              IF         (&TYPE *EQ DSPF) DO
  560.              RTVMSG     MSGID(PGM0006) MSGF(PGMMSGF) MSGDTA(&PARM +
  561.                           *CAT &OBJLIB *CAT &SRCFILE *CAT &SRCLIB +
  562.                           *CAT &RSTDSP *CAT &DFRWRT *CAT &PUBAUT  +
  563.                           *CAT &TEXT) MSG(&CMD) /* Display file */
  564.              GOTO       CHECKCRT
  565.              ENDDO
  566.  
  567.              IF         (&TYPE *EQ LF)   DO
  568.              RTVMSG     MSGID(PGM0007) MSGF(PGMMSGF) MSGDTA(&PARM +
  569.                           *CAT &OBJLIB *CAT &SRCFILE *CAT &SRCLIB +
  570.                           *CAT &PUBAUT *CAT &TEXT) MSG(&CMD) /* +
  571.                           Logical file */
  572.              GOTO       CHECKCRT
  573.              ENDDO
  574.  
  575.              IF         (&TYPE *EQ MXDF)   DO
  576.              RTVMSG     MSGID(PGM0008) MSGF(PGMMSGF) MSGDTA(&PARM +
  577.                           *CAT &OBJLIB *CAT &SRCFILE *CAT &SRCLIB +
  578.                           *CAT &PUBAUT *CAT &TEXT) MSG(&CMD) /* Mixed  +
  579.                           file */
  580.              GOTO       CHECKCRT
  581.              ENDDO
  582.  
  583.              IF         (&TYPE *EQ PF)     DO
  584.              RTVMSG     MSGID(PGM0009) MSGF(PGMMSGF) MSGDTA(&PARM +
  585.                           *CAT &OBJLIB *CAT &SRCFILE *CAT &SRCLIB +
  586.                           *CAT &SIZE1 *CAT &SIZE2 *CAT &SIZE3 *CAT +
  587.                           &PUBAUT *CAT &TEXT) MSG(&CMD) /* Physical +
  588.                           file */
  589.              GOTO       CHECKCRT
  590.              ENDDO
  591.  
  592.              IF         (&TYPE *EQ PRTF)   DO
  593.              RTVMSG     MSGID(PGM0010) MSGF(PGMMSGF) MSGDTA(&PARM +
  594.                           *CAT &OBJLIB *CAT &SRCFILE *CAT &SRCLIB +
  595.                           *CAT &MAXRCD *CAT &PRTSCH *CAT +
  596.                           &PUBAUT *CAT &TEXT) MSG(&CMD) /* Printer +
  597.                           file */
  598.              GOTO       CHECKCRT
  599.              ENDDO
  600.  
  601.              IF         (&TYPE *EQ RPT)    DO
  602.              RTVMSG     MSGID(PGM0011) MSGF(PGMMSGF) MSGDTA(&PARM +
  603.                           *CAT &OBJLIB *CAT &SRCFILE *CAT &SRCLIB +
  604.                           *CAT &USRPRF *CAT &PUBAUT *CAT &TEXT) +
  605.                           MSG(&CMD) /* RPGIII auto report program */
  606.              GOTO       CHECKCRT
  607.              ENDDO
  608.  
  609.              IF         (&TYPE *EQ RPG)    DO
  610.              RTVMSG     MSGID(PGM0012) MSGF(PGMMSGF) MSGDTA(&PARM +
  611.                           *CAT &OBJLIB *CAT &SRCFILE *CAT &SRCLIB +
  612.                           *CAT &GENOPT *CAT &USRPRF *CAT &PUBAUT *CAT +
  613.                           &TEXT) MSG(&CMD) /* RPGIII program */
  614.              GOTO       CHECKCRT
  615.              ENDDO
  616.  
  617.              IF         (&TYPE *EQ CBL)    DO
  618.              RTVMSG     MSGID(PGM0013) MSGF(PGMMSGF) MSGDTA(&PARM +
  619.                           *CAT &OBJLIB *CAT &SRCFILE *CAT &SRCLIB +
  620.                           *CAT &USRPRF *CAT &PUBAUT *CAT &TEXT) +
  621.                           MSG(&CMD) /* COBOL program */
  622.              GOTO       CHECKCRT
  623.              ENDDO
  624.  
  625.              IF         ((&TYPE *EQ PL1) *OR (&TYPE *EQ PLI)) DO
  626.              RTVMSG     MSGID(PGM0014) MSGF(PGMMSGF) MSGDTA(&PARM +
  627.                           *CAT &OBJLIB *CAT &SRCFILE *CAT &SRCLIB +
  628.                           *CAT &USRPRF *CAT &PUBAUT *CAT &TEXT) +
  629.                           MSG(&CMD) /* PL/1 program */
  630.              GOTO       CHECKCRT
  631.              ENDDO
  632.  
  633.              IF         (&TYPE *EQ ASM)    DO
  634.              RTVMSG     MSGID(PGM0015) MSGF(PGMMSGF) MSGDTA(&PARM +
  635.                           *CAT &OBJLIB *CAT &SRCFILE *CAT &SRCLIB +
  636.                           *CAT &USRPRF *CAT &PUBAUT *CAT &TEXT) +
  637.                           MSG(&CMD) /* ASM (MI) program */
  638.              GOTO       CHECKCRT
  639.              ENDDO
  640.  
  641.              IF         (&TYPE *EQ BASP)   DO
  642.              RTVMSG     MSGID(PGM0016) MSGF(PGMMSGF) MSGDTA(&PARM +
  643.                           *CAT &OBJLIB *CAT &SRCFILE *CAT &SRCLIB +
  644.                           *CAT &USRPRF *CAT &PUBAUT *CAT &TEXT) +
  645.                           MSG(&CMD) /* BASIC program */
  646.              GOTO       CHECKCRT
  647.              ENDDO
  648.  
  649.              IF         (&TYPE *EQ BSCF)   DO
  650.              RTVMSG     MSGID(PGM0017) MSGF(PGMMSGF) MSGDTA(&PARM +
  651.                           *CAT &OBJLIB *CAT &SRCFILE *CAT &SRCLIB +
  652.                           *CAT &PUBAUT *CAT &TEXT) MSG(&CMD) /* +
  653.                           Bysinc file */
  654.              GOTO       CHECKCRT
  655.              ENDDO
  656.  
  657.  BADTYPE:    /*         If Type: ____ not found, then cancel CRTxxx */
  658.  
  659.              SNDPGMMSG  MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' +
  660.                           *CAT 'Type:' *CAT &X26 *CAT &TYPE *CAT &X22 +
  661.                           *CAT 'not valid for create object.') +
  662.                           TOPGMQ(*SAME) MSGTYPE(*DIAG)
  663.              GOTO       ERROR
  664.  
  665.  CHECKCRT:   IF         (&IN23) DO  /* Delete Obj & Prompt CRTxxx */
  666.                CHGVAR     VAR(&IN04) VALUE('1') /* Prompter */
  667.                CHGVAR     VAR(&IN11) VALUE('1') /* Delete object */
  668.                CHGVAR     VAR(&IN23) VALUE('0')
  669.              ENDDO
  670.  
  671.              IF         (&IN16) CHGVAR VAR(&IN04) VALUE(&ON)
  672.  
  673.              IF         (&IN04) DO /* Prompter ? */
  674.                CHGVAR     VAR(&CMD) VALUE('?' *CAT &CMD)
  675.                CALL       PGM(QCACHECK) PARM(&CMD 512) /* Verify CMD */
  676.                MONMSG     MSGID(CPF6801) EXEC(DO) /* If CMD1, cancel */
  677.                  GOTO       ERROR
  678.                ENDDO
  679.                MONMSG     MSGID(CPF0000) EXEC(DO)
  680.                  GOTO       ERROR
  681.                ENDDO
  682.              ENDDO
  683.  
  684.              GOTO       GETOBJ  /* Execute subroutine GETOBJ  */
  685.  
  686.  CHKOBJ:      CHKOBJ     OBJ(&OBJNAME.&LIBNAME) OBJTYPE(&OBJTYPE) +
  687.                           AUT(*OBJEXIST)
  688.               MONMSG     MSGID(CPF9801) EXEC(DO)
  689.                RCVMSG     /*  Check prompter  Object.Lib names */
  690.  
  691.                SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  692.                           KEYVAR(&MSGKEY)
  693.                RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  694.                           RMV(*NO)
  695.  
  696.                GOTO       CRTOBJ
  697.               ENDDO
  698.  
  699.                SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  700.                           KEYVAR(&MSGKEY)
  701.                RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  702.                           RMV(*NO)
  703.  
  704.  DLTOBJ:      IF         (&IN11) DO
  705.                DLTOBJ     OBJ(&OBJNAME.&LIBNAME) TYPE(&OBJTYPE)
  706.               ENDDO
  707.               ELSE       DO  /* Object exists, display error msg */
  708.                 RMVMSG     MSGKEY(&MSGKEY)
  709.                 CHGVAR     VAR(&P16)  VALUE(&IN16)
  710.                 CHGVAR     VAR(&P04)  VALUE(&IN04)
  711.                 CHGVAR     VAR(&PARM) VALUE(&OBJNAME)
  712.                 CHGVAR     VAR(&OBJLIB) VALUE(&LIBNAME)
  713.                 CHGVAR     VAR(&IN85) VALUE('1')
  714.                 SNDF       RCDFMT(PGMMENU)
  715.                 CHGVAR     VAR(&IN83) VALUE('1')
  716.  NOTIFY:       GOTO         MSGCTL
  717.               ENDDO
  718.  
  719.  
  720.  CRTOBJ:     /*         Create object procedure */
  721.              CALL       PGM(QCACHECK) PARM(&CMD 512) /* Verify CMD  */
  722.              MONMSG     MSGID(CPF0000) EXEC(DO)  /* If Errs cancel */
  723.                GOTO       ERROR
  724.              ENDDO
  725.  
  726.  SECLVL:     IF         (&IN16)   DO   /* Second level prompting */
  727.  CRTOBJ2:    ?          SBMJOB JOB(&PARM) JOBD(&JOBD.&JOBDLIB) +
  728.                           RQSDTA(%SST(&CMD 01 512))
  729.              ENDDO
  730.              ELSE       DO
  731.  CRTOBJ1:    SBMJOB     JOB(&PARM) JOBD(&JOBD.&JOBDLIB) +
  732.                           RQSDTA(%SST(&CMD 01 512))
  733.              ENDDO
  734.  
  735.              GOTO       ERROR
  736.              ENDDO
  737.  
  738.  OPTION4:    IF         (&OPTION *EQ 4) +
  739.              DO         /* Call a program */
  740.  
  741.              CHGVAR     VAR(&CMD) VALUE('Option 4: Call - ' *CAT +
  742.                           &PARM *TCAT '.' *TCAT &OBJLIB)
  743.  
  744.              SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  745.                           KEYVAR(&MSGKEY)
  746.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  747.                           RMV(*NO)
  748.  
  749.              IF         (&PARM *EQ &BLANKS) DO
  750.              SNDPGMMSG  MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' +
  751.                           *CAT 'Program name cannot be blank when +
  752.                           calling a program.') TOPGMQ(*SAME) +
  753.                           MSGTYPE(*DIAG)
  754.              GOTO       MENU
  755.              ENDDO
  756.  
  757.              IF         (&OBJLIB *EQ ' ') DO
  758.              CALL       PGM(&PARM.*LIBL)
  759.              ENDDO
  760.              ELSE       DO
  761.              CALL       PGM(&PARM.&OBJLIB)
  762.              ENDDO
  763.  
  764.              GOTO       ERROR
  765.              ENDDO
  766.  
  767.  OPTION5:    /*         Execute command. */
  768.  OPTION6:    /*         Submit command string.  */
  769.              IF         ((&OPTION *EQ 5) *OR (&OPTION *EQ 6)) DO
  770.              CHGVAR     VAR(&PROMPT) VALUE('*NO ')
  771.  
  772.              IF          (&IN04 *OR (&IN16 *AND &OPTION *EQ 6)) DO
  773.                CHGVAR    VAR(&PROMPT) VALUE('*YES')
  774.                IF        (&COMMAND *NE &BLANKS) DO
  775.                CHGVAR    VAR(&OFFSET1) VALUE(1)
  776.  
  777.  BLANKTUNC:  IF         (%SST(&COMMAND &OFFSET1 01) *EQ &BLANK) DO
  778.              CHGVAR     VAR(&OFFSET2) VALUE(&OFFSET1 + 1)
  779.              CHGVAR     VAR(&LENGTH) VALUE(150 - &OFFSET1)
  780.              CHGVAR     VAR(&COMMAND) VALUE(%SST(&COMMAND &OFFSET2 +
  781.                           &LENGTH))
  782.              GOTO       BLANKTUNC
  783.              ENDDO
  784.              ENDDO
  785.                   CHGVAR     VAR(&COMMAND) VALUE(' ' *TCAT &COMMAND)
  786.  
  787.                IF         (%SST(&COMMAND 01 01) *NE '?') +
  788.                     CHGVAR   VAR(&COMMAND) VALUE('?' *TCAT &COMMAND)
  789.              ENDDO
  790.  
  791.              CHGVAR     VAR(&CMD) VALUE(&COMMAND) /* Work variable */
  792.  
  793.              SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  794.                           KEYVAR(&MSGKEY)
  795.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  796.                           RMV(*NO)
  797.  
  798.              CALL       PGM(QCACHECK) PARM(&CMD 512)
  799.              MONMSG     MSGID(CPF0000) EXEC(DO)
  800.                IF         (&OPTION *EQ 6) +
  801.                             CHGVAR VAR(&IN84) VALUE('1')
  802.                IF         (&PROMPT *EQ *YES) CHGVAR VAR(&COMMAND) +
  803.                              VALUE(%SST(&CMD 02 150))
  804.                ELSE       CHGVAR VAR(&COMMAND) VALUE(%SST(&CMD 01 150))
  805.                GOTO       ERROR
  806.              ENDDO
  807.  
  808.                RMVMSG     MSGKEY(&MSGKEY)
  809.  
  810.                SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  811.                             KEYVAR(&MSGKEY)
  812.                RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  813.                             RMV(*NO)
  814.  
  815.              CHGVAR     VAR(&COMMAND) VALUE(%SST(&CMD 1 150))
  816.  
  817.              IF         (&OPTION *EQ 5) DO  /* Execute command */
  818.                CALL       PGM(QCAEXEC) PARM(&CMD 512)
  819.              ENDDO
  820.              ELSE       DO  /* Submit job  */
  821.                IF         (&PARM *EQ &BLANKS) CHGVAR VAR(&JOBNAME) +
  822.                                                  VALUE(&WSID)
  823.                ELSE       CHGVAR VAR(&JOBNAME) VALUE(&PARM)
  824.  
  825.                IF         (&IN16)   DO  /* Second level prompting */
  826.                  ?  SBMJOB  JOB(&JOBNAME) JOBD(&JOBD.&JOBDLIB) +
  827.                             RQSDTA(%SST(&CMD 01 256))
  828.                ENDDO
  829.                ELSE       DO
  830.                SBMJOB     JOB(&JOBNAME) JOBD(&JOBD.&JOBDLIB) +
  831.                             RQSDTA(%SST(&CMD 01 256))
  832.                ENDDO
  833.              ENDDO
  834.  
  835.              GOTO       ERROR
  836.              ENDDO
  837.  
  838.  OPTION7:    IF (&OPTION *EQ 7)  +
  839.  DSPSBMJOB:  DO  /* Display submitted jobs */
  840.  
  841.              CHGVAR     VAR(&CMD) VALUE('Option 7: Display Submitted +
  842.                           jobs.')
  843.              SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  844.                           KEYVAR(&MSGKEY)
  845.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  846.                           RMV(*NO)
  847.  
  848.              IF         (&IN04) DO    /* Prompting requested ? */
  849.              ?          DSPSBMJOB
  850.              ENDDO
  851.              ELSE       +
  852.              DSPSBMJOB  SBMFROM(*JOB)
  853.              GOTO       MENU
  854.              ENDDO
  855.  
  856.  OPTION8:    IF         (&OPTION *EQ 8)  +
  857.  EDTSRC:     DO         /*   Source entry utility.  */
  858.              IF         (&TYPE *EQ &BLANKS) CHGVAR VAR(&SRCTYPE) +
  859.                           VALUE(*SAME)  /*  Default to TYPE(*SAME) */
  860.    ELSE      IF         (&TYPE *EQ DDS) CHGVAR VAR(&SRCTYPE) +
  861.                           VALUE(*SAME)  /*  Default to TYPE(*SAME) */
  862.    ELSE      IF         (&TYPE *EQ ASM) CHGVAR VAR(&SRCTYPE) +
  863.                           VALUE(*TXT)  /*  Default to TYPE(*TXT) */
  864.    ELSE      IF         (&TYPE *EQ FMT) CHGVAR VAR(&SRCTYPE) +
  865.                           VALUE(*TXT)  /*  Default to TYPE(*TXT) */
  866.    ELSE      CHGVAR     VAR(&SRCTYPE) VALUE('*' *CAT &TYPE)
  867.  
  868.              IF         ((&MBRLST *EQ '*NO')  *AND (&PARM *EQ ' ')) +
  869.                           CHGVAR VAR(&PARM) VALUE('*SELECT')
  870.              IF         ((&PARM *EQ '* ') *OR (&PARM *EQ '?')) +
  871.                           CHGVAR VAR(&PARM) VALUE('*SELECT')
  872.  
  873.              IF         (&TYPE *EQ TXT) DO
  874.               CHGVAR     VAR(&CMD) VALUE('Option 8: EDTTXT - SrcF:' +
  875.                           *BCAT &SRCFILE *TCAT '.' *CAT &SRCLIB *BCAT +
  876.                           'Mbr:' *BCAT &PARM)
  877.  
  878.               SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  879.                           KEYVAR(&MSGKEY)
  880.               RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  881.                           RMV(*NO)
  882.  
  883.              IF         (&PARM *EQ &BLANKS) DO
  884.              SNDPGMMSG  MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' +
  885.                           *CAT 'Src-Mbr name cannot be blank, use an +
  886.                           asterisk (*) if a member list desired.') +
  887.                           TOPGMQ(*SAME) MSGTYPE(*DIAG)
  888.               GOTO       ERROR
  889.              ENDDO
  890.  
  891.      /*        EDTDOC.QTXT SRCFILE(&SRCFILE.&SRCLIB) DOCUMENT(&PARM) */
  892.              ENDDO
  893.  
  894.       ELSE   DO
  895.               CHGVAR     VAR(&CMD) VALUE('Option 8: EDTSRC - SrcF:' +
  896.                           *BCAT &SRCFILE *TCAT '.' *CAT &SRCLIB *BCAT +
  897.                           'Mbr:' *BCAT &PARM)
  898.               SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  899.                           KEYVAR(&MSGKEY)
  900.               RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  901.                           RMV(*NO)
  902.  
  903.              IF         (&PARM *EQ &BLANKS) DO
  904.              SNDPGMMSG  MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' +
  905.                           *CAT 'Src-Mbr name cannot be blank, use an +
  906.                           asterisk (*) if a member list desired.') +
  907.                           TOPGMQ(*SAME) MSGTYPE(*DIAG)
  908.               GOTO       ERROR
  909.              ENDDO
  910.  
  911.                IF         (&TEXT *EQ &BLANKS) DO
  912.                  EDTSRC     SRCFILE(&SRCFILE.&SRCLIB) SRCMBR(&PARM) +
  913.                               TYPE(&SRCTYPE)
  914.                ENDDO
  915.                ELSE       DO
  916.                  EDTSRC     SRCFILE(&SRCFILE.&SRCLIB) SRCMBR(&PARM) +
  917.                               TYPE(&SRCTYPE) TEXT(&TEXT)
  918.                ENDDO
  919.  
  920.               IF         (&PARM *EQ '*SELECT') DO
  921.                 CHGVAR   VAR(&PARM) VALUE(&BLANKS)
  922.  
  923.                 RCVMSG   MSGTYPE(*COMP) RMV(*NO) MSGDTA(&MSGDTA) +
  924.                           MSGID(&MSGID)
  925.                 IF       (&MSGID *EQ 'EDT0014') +
  926.                          CHGVAR VAR(&PARM) VALUE(%SST(&MSGDTA 09 10))
  927.               ENDDO
  928.             ENDDO
  929.  
  930.             GOTO       ERROR
  931.           ENDDO
  932.  
  933.  OPTION9:    IF         (&OPTION *EQ 9) DO
  934.              /*         Screen design aid.  */
  935.  
  936.              CHGVAR     VAR(&CMD) VALUE('Option 9: Design display +
  937.                           format - ' *CAT &PARM *TCAT '.' *CAT +
  938.                           &OBJLIB *BCAT 'JobD - ' *CAT &JOBD *TCAT +
  939.                           '.' *CAT &JOBDLIB)
  940.              SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  941.                           KEYVAR(&MSGKEY)
  942.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  943.                           RMV(*NO)
  944.  
  945.              IF         (&PARM *EQ &BLANKS) DO
  946.              DSNFMT     SRCFILE(&SRCFILE.&SRCLIB) OBJLIB(&OBJLIB) +
  947.                           JOBD(&JOBD.&JOBDLIB)
  948.              ENDDO
  949.              ELSE       DO
  950.              DSNFMT     SRCFILE(&SRCFILE.&SRCLIB) SRCMBR(&PARM) +
  951.                           OBJLIB(&OBJLIB) JOBD(&JOBD.&JOBDLIB)
  952.              ENDDO
  953.              GOTO       MENU
  954.              ENDDO
  955.  
  956.  OPTION10:   /*         NoOp */
  957.  
  958.  OPTION11:   IF         (&OPTION *EQ 11) DO
  959.              /*         Copy source file member.  */
  960.  
  961.              CHGVAR     VAR(&CMD) VALUE('Option 11: CopyFile - ' *CAT +
  962.                           &SRCFILE *TCAT '.' *CAT &SRCLIB *BCAT 'Mbr +
  963.                           - ' *CAT &PARM *BCAT 'ToFile - ' *CAT &PARM)
  964.              SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  965.                           KEYVAR(&MSGKEY)
  966.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  967.                           RMV(*NO)
  968.  
  969.              RTVMSG     MSGID(PGM2011) MSGF(PGMMSGF) MSGDTA(&PARM +
  970.                           *CAT &SRCFILE *CAT &SRCLIB *CAT &PARM2) +
  971.                            MSG(&CMD)
  972.              IF         (&IN04) CHGVAR VAR(&CMD) VALUE('?' *CAT &CMD)
  973.              CALL       QCaCheck PARM(&CMD 512)
  974.  
  975.              SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  976.                           KEYVAR(&MSGKEY)
  977.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  978.                           RMV(*NO)
  979.  
  980.              CALL       QCAEXEC PARM(&CMD 512)
  981.              GOTO       MENU
  982.              ENDDO
  983.  
  984.  OPTION12:   /*         NoOp */
  985.  OPTION13:   /*         NoOp */
  986.  OPTION14:   /*         NoOp */
  987.  
  988.  OPTION15:   IF         (&OPTION *EQ 15) DO
  989.              /*         Add library list entry.  */
  990.  
  991.              CHGVAR     VAR(&CMD) VALUE('Option 15: AddLibLE - ' *CAT +
  992.                           &PARM *BCAT 'Position - ' *CAT &PARM2)
  993.              SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  994.                           KEYVAR(&MSGKEY)
  995.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  996.                           RMV(*NO)
  997.  
  998.              IF         (&PARM *NE &BLANKS) DO
  999.                IF         (&PARM2 *EQ *LAST)  +
  1000.                  ADDLIBLE   LIB(&PARM) POSITION(*LAST)
  1001.                ELSE       +
  1002.                  ADDLIBLE   LIB(&PARM)
  1003.                ENDDO
  1004.             GOTO       ERROR
  1005.             ENDDO
  1006.  
  1007.  OPTION16:   /*         NoOp */
  1008.  OPTION17:   /*         NoOp */
  1009.  OPTION18:   /*         NoOp */
  1010.  
  1011.  OPTION19:   IF         (&OPTION *EQ 19) DO
  1012.              /*         Design Advanced printer function */
  1013.  
  1014.              CHGVAR     VAR(&CMD) VALUE('Option 19: DSNAPF - +
  1015.                           Design Advanced Printer Function.  APF menu +
  1016.                           requested.')
  1017.              SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  1018.                           KEYVAR(&MSGKEY)
  1019.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  1020.                           RMV(*NO)
  1021.  
  1022.              CALL  QCAEXEC PARM('DSNAPF' 6)
  1023.               GOTO       MENU
  1024.              ENDDO
  1025.  
  1026.  OPTION20:   /*         NoOp */
  1027.  
  1028.  OPTION80:   IF         (&OPTION *EQ 80) DO
  1029.  
  1030.              CHGVAR     VAR(&CMD) VALUE('Option 80: DSPMNU - Display +
  1031.                           CPF command menu.  Sub-menu ' *CAT &PARM +
  1032.                           *BCAT 'requested.')
  1033.              SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  1034.                           KEYVAR(&MSGKEY)
  1035.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  1036.                           RMV(*NO)
  1037.  
  1038.              IF         ((&PARM *EQ 'CMDGRP') *OR (&PARM *EQ 'VERB') +
  1039.                           *OR (&PARM *EQ 'SUBJECT')) DO
  1040.                ?          DSPMNU MENU(&PARM)
  1041.              ENDDO
  1042.              ELSE       DO
  1043.                  ?          DSPMNU
  1044.              ENDDO
  1045.                GOTO       MENU
  1046.              ENDDO
  1047.  
  1048.  OPTION90:   IF         (&OPTION *EQ 90) +
  1049.              DO
  1050.  
  1051.              IF         COND((&PARM *NE '*NOLIST') *OR (&PARM *NE +
  1052.                           '*LIST')) THEN(CHGVAR VAR(&PARM) +
  1053.                             VALUE(&SIGNOFF))
  1054.  
  1055.              CHGVAR     VAR(&CMD) VALUE('Option 90: SignOff the +
  1056.                          CL-Programmer Menu.  Option - ' *CAT &PARM)
  1057.              SNDPGMMSG  MSG(&CMD) TOPGMQ(*SAME) MSGTYPE(*RQS) +
  1058.                           KEYVAR(&MSGKEY)
  1059.              RCVMSG     PGMQ(*SAME) MSGTYPE(*RQS) MSGKEY(&MSGKEY) +
  1060.                           RMV(*NO)
  1061.  
  1062.              SIGNOFF    LOG(&PARM)
  1063.  
  1064.              GOTO       ERROR
  1065.              ENDDO
  1066.  
  1067.              GOTO       MENU
  1068.              RETURN
  1069.  
  1070.     /*  BEGSR  */
  1071.  HELPTEXT:   /* Help text routine(s) begin here */
  1072.  HELPTEXT1:  SNDRCVF    RCDFMT(HELPTEXT1)
  1073.              IF         (*NOT &IN26) GOTO ROLL
  1074.  HELPTEXT2:  SNDRCVF    RCDFMT(HELPTEXT2)
  1075.              IF         (&IN27) GOTO HELPTEXT
  1076.              IF         (*NOT &IN26) GOTO ROLL
  1077.  HELPTEXT3:  SNDRCVF    RCDFMT(HELPTEXT3)
  1078.              IF         (&IN27) GOTO HELPTEXT1
  1079.              IF         (*NOT &IN26) GOTO ROLL
  1080.  HELPTEXT4:  SNDRCVF    RCDFMT(HELPTEXT4)
  1081.              IF         (&IN27) GOTO HELPTEXT2
  1082.              IF         (*NOT &IN26) GOTO ROLL
  1083.  HELPTEXT5:  SNDRCVF    RCDFMT(HELPTEXT5)
  1084.              IF         (&IN27) GOTO HELPTEXT3
  1085.              IF         (*NOT &IN26) GOTO ROLL
  1086.              GOTO       HELPTEXT
  1087.     /*    ENDSR  */
  1088.  
  1089.     /*  BEGSR  */
  1090.          /*  Get user's menu defaults. */
  1091.  GETDFT:     /*    Set up menu defaults */
  1092.              RTVDTAARA  DTAARA(%SST(&USROPT 01 10).%SST(&USROPT 11 +
  1093.                           10)) RTNVAR(&MNUDFT)
  1094.              MONMSG     MSGID(CPF1015) EXEC(DO)
  1095.              SNDPGMMSG  MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' +
  1096.                           *CAT 'No defaults found for user ' *CAT +
  1097.                           %SST(&USROPT 01 10) *TCAT '.' *CAT +
  1098.                           %SST(&USROPT 11 10)) TOPGMQ(*SAME) +
  1099.                           MSGTYPE(*DIAG)
  1100.                GOTO       ROLL
  1101.              ENDDO
  1102.  
  1103.  RTVUSRDFT:  /* Retrieve the user's menu defaults */
  1104.  
  1105.              DLTDTAARA  DTAARA(PGMDFT.QTEMP)
  1106.              MONMSG     MSGID(CPF0000)
  1107.  
  1108.              CRTDTAARA  DTAARA(PGMDFT.QTEMP) TYPE(*CHAR) LEN(2000) +
  1109.                           VALUE(&MNUDFT) TEXT('Current user''s user +
  1110.                           defaults.')
  1111.  
  1112.              CALL       PGM(CRC1233)              +
  1113.                            PARM(&XSRCFILE         +
  1114.                                 &XSRCLIB          +
  1115.                                 &XOBJLIB          +
  1116.                                 &JOBD             +
  1117.                                 &JOBDLIB          +
  1118.                                 &XLOG             +
  1119.                                 &SIGNOFF          +
  1120.                                 &LOGCLPGM         +
  1121.                                 &ALWRTVSRC        +
  1122.                                 &USRPRF           +
  1123.                                 &PUBAUT           +
  1124.                                 &RSTDSP           +
  1125.                                 &DFRWRT           +
  1126.                                 &SIZE1            +
  1127.                                 &SIZE2            +
  1128.                                 &SIZE3            +
  1129.                                 &MAXRCD           +
  1130.                                 &PRTSCH           +
  1131.                                 &BLINK            +
  1132.                                 &RSTLBL           +
  1133.                                 &LIBL             +
  1134.                                 &MBRLST           +
  1135.                                 &DFTYPE           +
  1136.                                 &SHARE            +
  1137.                                 &OPTIMIZE)
  1138.  
  1139.              DLTDTAARA  DTAARA(PGMDFT.QTEMP)
  1140.  
  1141.              CHGVAR     VAR(&XJOBD) VALUE(&JOBD *CAT &JOBDLIB) /* Set +
  1142.                           default job description */
  1143.  
  1144.              IF         (&BLINK *EQ *YES) CHGVAR VAR(&IN71) VALUE('1')
  1145.              ELSE       CHGVAR VAR(&IN71) VALUE('0')
  1146.              IF         (&LIBL *NE ' ') DO
  1147.              CHGVAR     &CMD VALUE('RPLLIBL (' *CAT &LIBL *BCAT ')')
  1148.              CALL       QCAEXEC PARM(&CMD 512)
  1149.              RCVMSG
  1150.              CHGVAR     VAR(&CMD) VALUE(&BLANKS)
  1151.              ENDDO
  1152.  
  1153.  
  1154.              GOTO       SNDRQSMSG
  1155.  
  1156.     /*    ENDSR  */
  1157.              GOTO       ROLL
  1158.  
  1159.     /*  BEGSR  */
  1160.   ERROR:     /*         Error trapping routine.  */
  1161.              CHGVAR     VAR(&CNT) VALUE(&CNT + 1)
  1162.              IF         (&CNT *GT 10) DO
  1163.              SNDPGMMSG  MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' +
  1164.                           *CAT 'Program message generation looped +
  1165.                           more than 10 times.  Cancel.') MSGTYPE(*DIAG)
  1166.              RETURN
  1167.              ENDDO
  1168.              GOTO       HEADING
  1169.  
  1170.     /*  ENDSR  */
  1171.  
  1172.     /*  BEGSR  */
  1173.     /* Get object.library name after prompter called. */
  1174.  GETOBJ:     CHGVAR     VAR(&CNT1) VALUE(1)
  1175.              CHGVAR     VAR(&NOLIB) VALUE('0')
  1176.              CHGVAR     VAR(&TWICE) VALUE('0')
  1177.  DOLOOP:     IF         (%SST(&CMD &CNT1 1) *EQ '(') +
  1178.              DO
  1179.                CHGVAR     VAR(&CNT1) VALUE(&CNT1 + 1)
  1180.  DOAGAIN:      CHGVAR     VAR(&WORKOBJ) VALUE(%SST(&CMD &CNT1 11))
  1181.                CHGVAR     VAR(&CNT2) VALUE(1)
  1182.  
  1183.  DO10:         IF        ((%SST(&WORKOBJ &CNT2 1) *EQ '.') +
  1184.                       *OR (%SST(&WORKOBJ &CNT2 1) *EQ ')')) +
  1185.                DO
  1186.                      IF ((%SST(&WORKOBJ &CNT2 1) *EQ ')') +
  1187.                           *AND (*NOT &TWICE)) DO
  1188.                           CHGVAR   VAR(&LIBNAME) VALUE('QGPL')
  1189.                           CHGVAR   VAR(&NOLIB) VALUE('1')
  1190.                      ENDDO
  1191.  
  1192.                  CHGVAR     VAR(&CNT3) VALUE((10 - &CNT2) + 2)
  1193.                  CHGVAR     VAR(%SST(&WORKOBJ &CNT2 &CNT3)) VALUE(' ')
  1194.  DO20:           IF         (&TWICE)  DO   /* PC/2 */
  1195.                  CHGVAR     VAR(&LIBNAME) VALUE(%SST(&WORKOBJ 1 10))
  1196.  ENDDO20:        ENDDO
  1197.  DO30:           ELSE         DO
  1198.                    CHGVAR     VAR(&OBJNAME) VALUE(%SST(&WORKOBJ 1 10))
  1199.                    IF         (&NOLIB) GOTO ENDGETOBJ
  1200.  
  1201.                    CHGVAR     VAR(&CNT1) VALUE(&CNT1 + &CNT2)
  1202.                    CHGVAR     VAR(&TWICE) VALUE('1')
  1203.                    GOTO       DOAGAIN
  1204.  ENDDO30:        ENDDO
  1205.  ENDDO10:      ENDDO
  1206.  
  1207.  DO50:         ELSE       DO
  1208.                  CHGVAR     VAR(&CNT2) VALUE(&CNT2 + 1)
  1209.                  IF         (&CNT2 *LE 11) GOTO DO10
  1210.  ENDDO50:      ENDDO
  1211.  
  1212.  ENDDOLOOP:  ENDDO
  1213.  DO60:       ELSE       DO
  1214.                CHGVAR     VAR(&CNT1) VALUE(&CNT1 + 1)
  1215.                IF         (&CNT1 *LT 512) GOTO DOLOOP
  1216.  ENDDO60:    ENDDO
  1217.  ENDGETOBJ:  GOTO          CHKOBJ
  1218.     /*  ENDSR  */
  1219.  
  1220.              ENDPGM
  1221.